0010 REM "XFRRXN -- REXON to PVX communications transfer program"
0030 REM "(c) Copyright 1988-1992, Sybex Ltd (Ontario, Canada)"
0040 DEF FNA(Q$)=ASC(Q$(1,1))+256*ASC(Q$(2,1))
0050 BEGIN 
0060 GOSUB 1000
0070 LET O$="L"; GOSUB 1100; GOSUB 1200; LET V$=X1$
0080 IF V$="" THEN GOTO 0150
0090 LET O$="M"; GOSUB 1100; GOSUB 1200; LET V2$=X1$
0100 LET O$="F"; GOSUB 1100; GOSUB 1200; LET V1$=X1$
0110 OPEN (3,ERR=0130)V$
0120 EXTRACT (3,KEY=V1$,DOM=0150); GOTO 0150
0130 LET V1$="ERROR="+STR(ERR); LET O$="!"; GOSUB 1100; LET O$=V1$; GOSUB 1100
0140 GOTO 0900
0150 IF V$<>"" THEN GOTO 0180
0160 LET O$="F"; GOSUB 1100; GOSUB 1200; LET P$=X1$
0170 IF P$="" THEN GOTO 0900 ELSE GOTO 0500
0180 LET P$=KEY(3,END=0900); READ (3)
0200 IF P$>V2$ THEN GOTO 0900
0500 REM "500 - TRANSMIT FILE"
0510 WAIT 1
0520 OPEN (2,ERR=0800)P$
0530 LET O1$=""
0540 LET F$=FID(2)
0550 LET X=ASC(F$(7)),D=INT(X/16),T=X-D*16,S=FNA(F$(13,2))
0560 IF AND(X$(7,1),$0C$)=$0C$ THEN LET D=D+16,T=T-12
0570 LET K=ASC(F$(8,1)),R=FNA(F$(11,2)),N=FNA(F$(9,2))
0580 IF K=0 THEN GOTO 0600
0600 IF T=2 THEN LET R=0,K=0,N=0
0610 LET K$=P$+"        ",O$=K$(1,8)+STR(R:"0000")+K1$+STR(N:"000000")
0620 GOSUB 1100
0630 IF T=2 THEN GOSUB 2000 ELSE GOSUB 3000
0640 IF O1$="" THEN LET O$="*"; GOSUB 1100
0650 GOSUB 1200
0660 CLOSE (2)
0670 GOTO 0150
0800 REM "800 - ERROR OPENING FILE"
0810 GOSUB 1900; GOTO 0640
0900 REM "900 - END OF SESSION"
0910 GOSUB 1320
0920 STOP 
1000 REM "1000- PREPARE COM"
1010 DIM B$(4000)
1020 LET B1=1,B$(1,4)="0001",B=11
1030 RETURN 
1100 REM "1100 - WRITE RECORD"
1110 LET U=LEN(O$)+4
1120 IF U+B>2000 THEN GOSUB 1200
1130 LET B$(B,U)=STR(U-4:"0000")+O$,B=B+U
1140 RETURN 
1200 REM "1200 - FLUSH BLOCK"
1210 LET B$(5,4)=STR(B-1:"0000"),B$(9,2)="**"; REM HTA(LRC(B$(11,B-11)))
1220 LET B2=1
1230 IF B-B2<75 THEN GOTO 1260
1240 PRINT "{",B$(B2,75),"}+"
1250 LET B2=B2+75; GOTO 1230
1260 PRINT "{",B$(B2,B-B2),"}?"
1270 INPUT (0,TIM=50,ERR=1220)'CI',X$
1280 IF LEN(X$)>1 THEN LET X1$=X$(2),X$=X$(1,1) ELSE LET X1$=""
1290 IF X$<>"Y" THEN WAIT 2; GOTO 1220
1300 IF B1=9999 THEN LET B1=0 ELSE LET B1=B1+1
1310 LET B$(1,5)=STR(B1:"0000"),B=11; RETURN 
1320 REM "1300 - CLOSE/FLUSH COMM"
1330 IF B<>11 THEN GOSUB 1200
1340 GOSUB 1200
1350 RETURN 
1900 REM "1900 - SEND ERROR MESSAGES"
1910 LET O1$="ERROR #"+STR(ERR); LET O$="!"; GOSUB 1100; LET O$=O1$; GOTO 1100
2000 REM "2000 - DEBLOCK PROGRAMS"
2010 CLOSE (2)
2020 DIM R$(256),R1$(256)
2030 GET D,S,R$
2040 LET R$=R$(16)
2050 LET S=S+1
2060 IF R$(1,1)=$9A$ THEN RETURN 
2070 LET L=FNA(R$(3,2))+4
2080 IF L+4<LEN(X$) THEN GOTO 2120
2090 GET D,S,R1$
2100 LET R$=R$+R1$,S=S+1
2110 GOTO 2080
2120 SETERR 1900
2130 LET O$=LST(R$)
2140 SETERR 0000
2150 IF O$(1,4)=" END" THEN RETURN 
2160 GOSUB 1100
2170 LET R$=R$(L+1); GOTO 2060
2500 REM "2500 - READ NEXT"
2510 READ RECORD (2,ERR=2530)R1$
2520 LET R$=R$(O)+R1$; LET O=1; RETURN 
2530 EXITTO 1900; REM "POP STACK AND RETURN ERROR"
3000 REM "3000 - EXTRACT DATA FILE"
3010 DIM Z$(R,$00$); LET K$=""
3020 IF K<>0 THEN LET K$=KEY(2,END=3110,ERR=1900); GOTO 3040
3030 LET K$=STR(IND(2,ERR=3110):"000000"); GOTO 3040
3040 LET R$="",L=0; READ RECORD (2,ERR=3045)R$; GOTO 3060
3045 IF K$="" THEN GOTO 3110 ELSE GOTO 3080
3050 GOTO 3060
3060 LET L=POS(Z$=R$+Z$)-1
3070 IF L<0 THEN LET L=0
3080 LET O$=K$+$8D$+R$(1,L)
3090 GOSUB 3500
3100 GOTO 3020
3110 RETURN 
3500 REM "3500 - CONVERT DATA"
3510 LET O=1
3520 LET O1=POS("z"<O$(O)); IF O1=0 THEN GOTO 3570
3530 LET O=O+O1-1
3540 IF O$(O,1)=$8D$ THEN LET O$(O,1)="|",O=O+1; GOTO 3520
3550 LET O$=O$(1,O-1)+"~"+HTA(O$(O,1))+O$(O+1),O=O+3
3560 GOTO 3520
3570 LET O=1
3580 LET O1=POS(" ">O$(O)); IF O1=0 THEN GOTO 1100
3590 LET O=O+O1-1
3600 IF O$(O,1)=$8D$ THEN LET O$(O,1)="|",O=O+1; GOTO 3580
3610 LET O$=O$(1,O-1)+"~"+HTA(O$(O,1))+O$(O+1),O=O+3
3620 GOTO 3580
